Answering Questions; Gather Data, Viking 9:10, 2021-08

# Check requisite packages are installed.
packages <- c(
  "plotly", 
  "dplyr"
)
for (pkg in packages) {
  library(pkg, character.only = TRUE)
}

package 㤼㸱plotly㤼㸲 was built under R version 4.0.5package 㤼㸱ggplot2㤼㸲 was built under R version 4.0.3package 㤼㸱dplyr㤼㸲 was built under R version 4.0.4

Tabs

Load

Pulling code almost directly from LM1996-NumPoolComScaling-Results-2021-05.Rmd.

dirViking <- c(
  file.path(
    getwd(), "LCAB_LawMorton1996-NumericalPoolCommunityScaling9"
  ),
  file.path(
    getwd(), "LCAB_LawMorton1996-NumericalPoolCommunityScaling10"
  )
)
dirVikingResults <- file.path(
  dirViking, c("save-2021-08-03") # Latter not 100% yet.
)
resultFormat <- paste0(
  "run-", 
  "%d", # Combination Number, or CombnNum.
  "-", 
  "%s", # Run Seed.
  ".RDS"
)

source(
  file.path(getwd(), 
            "LawMorton1996-NumericalPoolCommunityScaling-Settings9.R")
)

paramFrame <- with(list(
  b = rep(basal, times = length(consumer)),
  c = rep(consumer, each = length(basal)),
  s1 = seedsPrep[1:(length(basal) * length(consumer))],
  s2 = seedsPrep[
    (length(basal) * length(consumer) + 1):(
      2 * length(basal) * length(consumer))
  ],
  sR = seedsRun
), {
  temp <- data.frame(
    CombnNum = 0,
    Basals = b,
    Consumers = c,
    SeedPool = s1,
    SeedMat = s2,
    SeedRuns = "",
    SeedRunsNum = 0,
    EndStates = I(rep(list(""), length(b))),
    EndStatesNum = 0,
    EndStateSizes = I(rep(list(""), length(b))),
    EndStateSizesNum = NA,
    EndStateAssembly = I(rep(list(""), length(b))),
    EndStateAbundance = I(rep(list(""), length(b))),
    Dataset = "Viking9",
    DatasetID = 1,
    stringsAsFactors = FALSE
  )
  for (i in 1:nrow(temp)) {
    seeds <- sR[((i - 1) * runs + 1) : (i * runs)]
    temp$SeedRuns[i] <- toString(seeds) # CSV
    temp$SeedRunsNum[i] <- length(seeds)
  }
  temp$CombnNum <- 1:nrow(temp)
  temp
})

# Note: n + 2 end states. Failure to finish, failure to obtain state, and state.
for (i in 1:nrow(paramFrame)) {
  resultsList <- list(
    "No Run" = 0,
    "No State" = 0
  )
  resultsSize <- list(
    "0" = 0
  )
  resultsAssembly <- list(
    "No Run" = data.frame(),
    "No State" = data.frame()
  )
  resultsAbund <- list(
    "No Run" = "",
    "No State" = ""
  )
  seeds <- unlist(strsplit(paramFrame$SeedRuns[i], ', '))
  for (seed in seeds) {
    fileName <- file.path(
      dirVikingResults[paramFrame$DatasetID[i]],
      sprintf(resultFormat, paramFrame$CombnNum[i], seed)
    )
    
    if (file.exists(fileName)) {
      temp <- load(fileName)
      temp <- eval(parse(text = temp)) # Get objects.
      
      if (is.list(temp) && "Result" %in% names(temp)) {
        
        if (is.data.frame(temp$Result))
          community <- temp$Result$Community[[nrow(temp$Result)]]
        else 
          community <- temp$Result
        
        if (length(community) > 100) {
          print(paste(i, length(community), seed))
        }
        
        size <- toString(length(community))
        
        if (community[1] != "") 
          abund <- toString(temp$Abund[community + 1])
        else 
          abund <- ""
        
        community <- toString(community)
        
        if (community == "") {
          resultsList$`No State` <- resultsList$`No State` + 1
          resultsSize$`0` <- resultsSize$`0` + 1
          
        } else if (community %in% names(resultsList)) {
          resultsList[[community]] <- resultsList[[community]] + 1
          resultsSize[[size]] <- resultsSize[[size]] + 1
          
        } else {
          resultsList[[community]] <- 1
          resultsAssembly[[community]] <- temp
          resultsAbund[[community]] <- abund
          
          if (size %in% resultsSize) {
            resultsSize[[size]] <- resultsSize[[size]] + 1
          } else {
            resultsSize[[size]] <- 1
          }
        }
      } else {
        resultsList$`No State` <- resultsList$`No State` + 1
        resultsSize$`0` <- resultsSize$`0` + 1
      }
    } else {
      resultsList$`No Run` <- resultsList$`No Run` + 1
      resultsSize$`0` <- resultsSize$`0` + 1
    }
  }
  
  paramFrame$EndStates[[i]] <- resultsList
  paramFrame$EndStatesNum[i] <- length(resultsList) - 2 # ! No State, No Run
  paramFrame$EndStateSizes[[i]] <- resultsSize
  paramFrame$EndStateSizesNum[i] <- length(resultsSize) - 1 # ! 0
  paramFrame$EndStateAssembly[[i]] <- resultsAssembly
  paramFrame$EndStateAbundance[[i]] <- resultsAbund
}

[1] "10 119 95557008.0550388"
[1] "10 116 69699811.3999143"

source(
  file.path(getwd(), 
            "LawMorton1996-NumericalPoolCommunityScaling-Settings10.R")
)

oldNrow <- nrow(paramFrame)

paramFrame <- rbind(paramFrame, with(list(
  b = rep(basal, times = length(consumer)),
  c = rep(consumer, each = length(basal)),
  s1 = seedsPrep[1:(length(basal) * length(consumer))],
  s2 = seedsPrep[
    (length(basal) * length(consumer) + 1):(
      2 * length(basal) * length(consumer))
  ],
  sR = seedsRun
), {
  temp <- data.frame(
    CombnNum = 0,
    Basals = b,
    Consumers = c,
    SeedPool = s1,
    SeedMat = s2,
    SeedRuns = "",
    SeedRunsNum = 0,
    EndStates = I(rep(list(""), length(b))),
    EndStatesNum = 0,
    EndStateSizes = I(rep(list(""), length(b))),
    EndStateSizesNum = NA,
    EndStateAssembly = I(rep(list(""), length(b))),
    EndStateAbundance = I(rep(list(""), length(b))),
    Dataset = "Viking10",
    DatasetID = 2,
    stringsAsFactors = FALSE
  )
  for (i in 1:nrow(temp)) {
    seeds <- sR[((i - 1) * runs + 1) : (i * runs)]
    temp$SeedRuns[i] <- toString(seeds) # CSV
    temp$SeedRunsNum[i] <- length(seeds)
  }
  temp$CombnNum <- 1:nrow(temp)
  temp
})
)

# Note: n + 2 end states. Failure to finish, failure to obtain state, and state.
# Modified from above, but with the abundance recorded.
for (i in (oldNrow + 1):nrow(paramFrame)) {
  resultsList <- list(
    "No Run" = 0,
    "No State" = 0
  )
  resultsSize <- list(
    "0" = 0
  )
  resultsAssembly <- list(
    "No Run" = data.frame(),
    "No State" = data.frame()
  )
  resultsAbund <- list(
    "No Run" = "",
    "No State" = ""
  )
  seeds <- unlist(strsplit(paramFrame$SeedRuns[i], ', '))
  for (seed in seeds) {
    fileName <- file.path(
      dirVikingResults[paramFrame$DatasetID[i]],
      sprintf(resultFormat, paramFrame$CombnNum[i], seed)
    )
    
    if (file.exists(fileName)) {
      temp <- load(fileName)
      temp <- eval(parse(text = temp)) # Get objects.
      
      if (is.list(temp) && "Result" %in% names(temp)) {
        
        if (is.data.frame(temp$Result))
          community <- temp$Result$Community[[nrow(temp$Result)]]
        else 
          community <- temp$Result
        
        if (length(community) > 100) {
          print(paste(i, length(community), seed))
        }
        
        size <- toString(length(community))
        
        if (community[1] != "") 
          abund <- toString(temp$Abund[community + 1])
        else 
          abund <- ""
        
        community <- toString(community)
        
        if (community == "") {
          resultsList$`No State` <- resultsList$`No State` + 1
          resultsSize$`0` <- resultsSize$`0` + 1
          
        } else if (community %in% names(resultsList)) {
          resultsList[[community]] <- resultsList[[community]] + 1
          resultsSize[[size]] <- resultsSize[[size]] + 1
          
        } else {
          resultsList[[community]] <- 1
          resultsAssembly[[community]] <- temp
          resultsAbund[[community]] <- abund
          
          if (size %in% resultsSize) {
            resultsSize[[size]] <- resultsSize[[size]] + 1
          } else {
            resultsSize[[size]] <- 1
          }
        }
      } else {
        resultsList$`No State` <- resultsList$`No State` + 1
        resultsSize$`0` <- resultsSize$`0` + 1
      }
    } else {
      resultsList$`No Run` <- resultsList$`No Run` + 1
      resultsSize$`0` <- resultsSize$`0` + 1
    }
  }
  
  paramFrame$EndStates[[i]] <- resultsList
  paramFrame$EndStatesNum[i] <- length(resultsList) - 2 # ! No State, No Run
  paramFrame$EndStateSizes[[i]] <- resultsSize
  paramFrame$EndStateSizesNum[i] <- length(resultsSize) - 1 # ! 0
  paramFrame$EndStateAssembly[[i]] <- resultsAssembly
  paramFrame$EndStateAbundance[[i]] <- resultsAbund
}

[1] "40 102 26674330.2810937"
[1] "40 102 39581658.8308662"
[1] "40 102 62868591.6075483"
[1] "40 102 56308729.4343859"
[1] "40 102 19815561.3383278"
[1] "40 102 18465117.5979525"
[1] "40 102 26095917.3552692"
[1] "40 102 60475607.9846993"
[1] "40 102 69888928.7887141"
[1] "40 102 99290275.8764103"
[1] "40 102 9528546.3379696"
[1] "40 102 93055356.4801812"
[1] "40 102 68074182.04844"
[1] "40 102 98843143.6475366"
[1] "40 102 46835659.747012"
[1] "40 102 73302648.1466368"
[1] "40 102 57818840.3043896"
[1] "40 102 16893954.4353634"
[1] "40 102 34339508.8333637"
[1] "40 102 51167502.5569275"
[1] "40 102 22425330.9192136"
[1] "40 102 85563534.0558365"
[1] "40 102 56022880.6221858"
[1] "40 102 26422126.0789782"
[1] "40 102 35608488.8568148"
[1] "40 102 11042673.8159731"
[1] "40 102 83468216.2618265"
[1] "40 102 40178918.7919348"
[1] "40 102 19817898.0965167"
[1] "40 102 98183176.6199321"
[1] "40 102 91958070.2902749"
[1] "40 102 19873716.2863836"
[1] "40 102 71078193.699941"
[1] "40 102 99907531.9850817"
[1] "40 102 51399637.3396367"
[1] "40 102 41323695.4482272"
[1] "40 102 23621508.1531554"
[1] "40 102 71196689.6662489"
[1] "40 102 37134249.3221164"
[1] "40 102 64464564.4584671"
[1] "40 102 81891857.2738767"
[1] "40 102 25338337.9429579"
[1] "40 102 78799370.9789589"
[1] "40 102 9775842.88921207"
[1] "40 102 63896748.4002933"
[1] "40 102 7201567.82772392"
[1] "40 102 29442481.4870581"
[1] "40 102 10879790.9459099"
[1] "40 102 39187487.0983884"
[1] "40 102 44344145.3855485"
[1] "40 102 2694217.69771725"
[1] "40 102 58244740.8000007"
[1] "40 102 28041951.241903"
[1] "40 102 32239883.5560307"
[1] "40 102 22650681.8784401"
[1] "40 102 2473517.92640984"
[1] "40 102 68456584.3315795"
[1] "40 102 5582987.0980233"
[1] "40 102 48389758.2860664"
[1] "40 102 27699859.6265912"
[1] "40 102 55826936.5224987"
[1] "40 102 36236764.6303028"
[1] "40 102 82180834.6780017"
[1] "40 102 11491039.1857848"
[1] "40 102 689778.942614794"
[1] "40 102 66809097.7473184"
[1] "40 102 31505824.4392276"
[1] "40 102 79718462.9132971"
[1] "40 102 77086616.5170446"
[1] "40 102 76446791.1561951"
[1] "40 102 98389471.7181101"
[1] "40 102 78609766.2290558"
[1] "40 102 46250235.2427691"
[1] "40 102 19806321.3611022"
[1] "40 102 58000172.3021269"
[1] "40 102 93652395.8807811"
[1] "40 102 40964502.7481019"
[1] "40 102 30762933.1946373"
[1] "40 102 74916414.2878726"
[1] "40 102 69335297.6348251"
[1] "40 102 12855840.0087059"
[1] "40 102 49537618.8773662"
[1] "40 102 78466867.4459681"
[1] "40 102 16305246.2274209"
[1] "40 102 95725073.6420974"
[1] "40 102 50715170.4281569"
[1] "40 102 23608537.716791"
[1] "40 102 72722480.0502881"
[1] "40 102 94330947.380513"
[1] "40 102 63244247.9021847"
[1] "40 102 10481487.493962"
[1] "40 102 96970770.1122388"
[1] "40 102 71544740.581885"
[1] "40 102 3593988.85630071"
[1] "40 102 11239372.7293238"
[1] "40 102 46830266.6442469"
[1] "40 102 9484747.58770317"
[1] "40 102 58595952.9271349"
[1] "40 102 36778931.4361289"
[1] "40 102 7347386.53991371"
[1] "46 120 81955084.3443722"
[1] "47 320 95541944.145225"
[1] "47 320 8161125.23898482"
[1] "47 320 39323352.4635434"
[1] "47 320 80091710.0161314"
[1] "47 320 58265319.9788183"
[1] "47 320 67721453.2392099"
[1] "47 320 86982388.1192133"
[1] "47 320 80757901.3518989"
[1] "47 320 28097170.7077697"
[1] "47 320 51082268.1244463"
[1] "47 320 33807065.1283488"
[1] "48 1020 98442707.6997235"

Plot Preparation

# X, Y, Basal and Consumer.
# Z = Sizes of the Endstates.

plotScalingData <- data.frame(
  CombnNum = rep(paramFrame$CombnNum, paramFrame$EndStatesNum),
  Basals = rep(paramFrame$Basals, paramFrame$EndStatesNum),
  Consumers = rep(paramFrame$Consumers, paramFrame$EndStatesNum),
  Dataset = rep(paramFrame$Dataset, paramFrame$EndStatesNum),
  DatasetID = rep(paramFrame$DatasetID, paramFrame$EndStatesNum)
)

# Communities
comms <- unlist(lapply(paramFrame$EndStates, names))
freqs <- unlist(paramFrame$EndStates)
asmbl <- unlist(paramFrame$EndStateAssembly, recursive = FALSE)
asmbl <- asmbl[comms != "No Run" & comms != "No State"]
freqs <- freqs[comms != "No Run" & comms != "No State"]
comms <- comms[comms != "No Run" & comms != "No State"]

asmbl <- lapply(asmbl, function(d) {
  if (is.null(d)) return(NA)
  if ("Result.Outcome" %in% names(d))
    d %>% dplyr::filter(Result.Outcome != "Type 1 (Failure)" & 
                          Result.Outcome != "Present")
  else
    d$Result %>% dplyr::filter(Outcome != "Type 1 (Failure)" & 
                                 Outcome != "Present")
})

plotScalingData$Communities <- comms
plotScalingData$CommunityFreq <- freqs
plotScalingData$CommunitySeq <- asmbl

# Community Size
temp <- unlist(lapply(strsplit(plotScalingData$Communities, ','), length))
plotScalingData$CommunitySize <- temp

candidateData <- plotScalingData %>% dplyr::group_by(
  CombnNum, Dataset
) %>% dplyr::mutate(
  OtherSteadyStates = dplyr::n() - 1
)

Pools and Matrices

mats <- list()
poolsall <- list() # name pools used in save data; be careful!

for (i in 1:length(dirViking)) {
  temp <- load(file.path(
    dirViking[i], 
    paste0("LawMorton1996-NumericalPoolCommunityScaling-PoolMats", 
           c(9, 10)[i], 
           ".RDS")
  ))
  mats[[i]] <- eval(parse(text = temp[1]))
  poolsall[[i]] <- eval(parse(text = temp[2]))
}
pools <- poolsall

Abundances

# First, check if it is in the paramFrame.
# Second, check if it is in the saved data from the previous.
# Otherwise, ignore it, we'll figure out what it is and why it is missing later.

candidateData$CommunityAbund <- ""

for (r in 1:nrow(candidateData)) {
  # ID 1:4 are used to identify paramFrame, 5 used to identify abundance
  ID <- candidateData[r, 1:6]
  paramFrameRow <- paramFrame %>% dplyr::filter(
    CombnNum == ID$CombnNum,
    Basals == ID$Basals,
    Consumers == ID$Consumers,
    Dataset == ID$Dataset
  )
  
  if (is.list(paramFrameRow$EndStateAbundance[[1]])) {
    entry <- which(ID$Communities == names(paramFrameRow$EndStateAbundance[[1]]))
    if (length(entry)) {
      candidateData$CommunityAbund[r] <- paramFrameRow$EndStateAbundance[[1]][[entry]]
      next()
    }
  }
}

print(paste("Failures:", 
            sum(candidateData$CommunityAbund %in% 
                  c("", "Failure", "EstimatedFailure"))))

[1] "Failures: 0"

candidateData <- candidateData %>% dplyr::filter(CommunityAbund != "",
                                                 CommunityAbund != "Failure",
                                                 CommunityAbund != "EstimateFailure")

candidateData$CommunityProd <- NA
for (r in 1:nrow(candidateData)) {
  candidateData$CommunityProd[r] <- with(
    candidateData[r, ], 
    RMTRCode2::Productivity(
      Pool = pools[[DatasetID]][[CombnNum]], 
      InteractionMatrix = mats[[DatasetID]][[CombnNum]], 
      Community = Communities, 
      Populations = CommunityAbund
    )
  )
}

print(paste("Numerically Unstable:", 
            sum(candidateData$CommunityProd > 10^10 
                  )))

[1] "Numerically Unstable: 7"

candidateData <- candidateData %>% dplyr::filter(CommunityProd < 10^10)

Communities

# For usage by the reader.

plotScaling <- plotly::plot_ly(
  candidateData,
  x = ~Basals,
  y = ~Consumers,
  z = ~CommunitySize,
  color = ~Dataset,
  colors = c("red", "blue", "black")
)

plotScaling <- plotly::add_markers(plotScaling)

plotScaling <- plotly::layout(
  plotScaling,
  scene = list(
    xaxis = list(type = "log"),
    yaxis = list(type = "log"),
    camera = list(
      eye = list(
        x = -1.25, y = -1.25, z = .05
      )
    )
  )
)

plotScaling

Communities Data

candidateData

Foodwebs, Prep

foodWebs <- list()

for (r in 1:nrow(candidateData)) {
  foodWebs[[r]] <- with(
    candidateData[r, ],
    {
      redCom <- RMTRCode2::CsvRowSplit(Communities)
      redMat <- mats[[DatasetID]][[CombnNum]][redCom, redCom]
      redPool <- pools[[DatasetID]][[CombnNum]][redCom, ]
      
      colnames(redMat) <- paste0('s',as.character(redCom))
      rownames(redMat) <- colnames(redMat)
      
      names(redPool)[1] <- "node"
      redPool$node <- colnames(redMat)
      names(redPool)[3] <- "M"
      
      Graph <- igraph::graph_from_adjacency_matrix(
        redMat, weighted = TRUE
      )
      
      Graph <- igraph::set.vertex.attribute(
        Graph, "name", value = colnames(redMat)
      )
      
      redPool$N <- RMTRCode2::CsvRowSplit(CommunityAbund)
      
      # For later analysis, take the matrix diagonal.
      
      redPool$Intraspecific <- diag(redMat)
      
      GraphAsDataFrame <- igraph::as_data_frame(Graph)
  
      # Add in abundances for calculating abundance * (gain or loss)
      GraphAsDataFrame <- dplyr::left_join(
        GraphAsDataFrame,
        dplyr::select(redPool, node, N),
        by = c("to" = "node")
      )
  
      # Split data frame.
      ResCon <- GraphAsDataFrame[GraphAsDataFrame$weight > 0,]
      ConRes <- GraphAsDataFrame[GraphAsDataFrame$weight < 0,]
      
      # Reorder and rename variables.
      ResCon <- dplyr::select(ResCon, 
                                 to, from, # resource = to, consumer = from, 
                                 effectPerUnit = weight, resourceAbund = N)
      ConRes <- dplyr::select(ConRes, 
                                 to, from, # resource = from, consumer = to, 
                                 effectPerUnit = weight, consumerAbund = N)
      ResCon <- dplyr::mutate(dplyr::group_by(ResCon, from),
                              effectActual = effectPerUnit * resourceAbund,
                              Type = "Exploit+")
      ConRes <- dplyr::mutate(dplyr::group_by(ConRes, from),
                              effectActual = effectPerUnit * consumerAbund,
                              Type = ifelse(from == to,
                                            "SelfReg-",
                                            "Exploit-"))
      
      IntriG <- with(redPool, data.frame(
                              from = node, #resource = node,
                              to = node, #consumer = node,
                              effectPerUnit = ifelse(ReproductionRate > 0,
                                                   ReproductionRate, 0),
                              effectActual = ifelse(ReproductionRate > 0,
                                                  N * ReproductionRate, 0),
                              Type = "Intrisc+")) 
      IntriL <- with(redPool, data.frame(
                              from = node, #resource = node,
                              to = node, #consumer = node,
                              effectPerUnit = ifelse(ReproductionRate < 0,
                                                   ReproductionRate, 0),
                              effectActual = ifelse(ReproductionRate < 0,
                                                  N * ReproductionRate, 0),
                              Type = "Intrisc-"))
      
      EdgeDataFrame <- dplyr::bind_rows(
        dplyr::select(ResCon, -resourceAbund), 
        dplyr::select(ConRes, -consumerAbund),
        IntriG, IntriL
      )
      
      EdgeDataFrame <- EdgeDataFrame %>% dplyr::rename(
        # Empirically speaking, to and from appear reversed.
        # A consumer (from) should have a negative effect on resource (to),
        # but the organisation so far marks it as positive. We fix this.
        tempname = to,
        to = from
      ) %>% dplyr::rename(
        from = tempname
      ) %>% dplyr::filter(
        # Remove placeholder entries
        effectPerUnit != 0
      ) %>% dplyr::mutate(
        # Useful to keep effects separate
        effectSign = sign(effectPerUnit)
      ) %>% group_by(
        to, effectSign
      ) %>% dplyr::mutate(
        # Perform the post mortem of the most influential from's
        effectEfficiency = effectPerUnit / sum(effectPerUnit), 
        effectNormalised = effectActual / sum(effectActual)
      ) %>% dplyr::arrange(to)
      
      list(
        Edges = EdgeDataFrame,
        Vertices = redPool
      )
    }
  )
}

toCheddar <- function(EVList, name = "") {# Edges Vertices List
  links <- EVList$Edges

  # cheddar does not like "cannibalism".
  links <- links[
    links$to != links$from,
  ]

  # "[C]olumns called ‘resource’ and ‘consumer’ must be given."
  links <- dplyr::bind_rows(
    links %>% dplyr::filter(effectSign == 1) %>% dplyr::rename(
      resource = from, consumer = to),
    links %>% dplyr::filter(effectSign == -1) %>% dplyr::rename(
      resource = to, consumer = from),
  ) %>% dplyr::select(-Type) # Cheddar confuses node Type and edge Type.

  cheddar::Community(
    nodes = EVList$Vertices,
    properties = list(
      title = name,
      M.units = "masses",
      N.units = "abund"
    ),
    trophic.links = links
  )
}

toIGraph <- function(EVList, sign = 0) {
  igraph::graph_from_data_frame(
    d = if(sign == 0) {
      EVList$Edges
    } else {
      EVList$Edges[EVList$Edges$effectSign == sign, ]
    },
    directed = TRUE,
    vertices = EVList$Vertices
  )
}


toPostMortem <- function(EVList,
                         threshold = 0, # sets to minimal size edges below
                         nodeSize = c("None", "Abundance", "Size"),
                         edgeScale = 10,
                         reducedTrophic = TRUE) {
  if (tolower(threshold) == "adaptive") {
    threshold = EVList$Edges %>% group_by(
      to, effectSign
    ) %>% summarise(
      max = max(effectNormalised), .groups = "drop"
    ) %>% ungroup %>% pull(max) %>% min
  }

  theGc <- toCheddar(EVList, name = "Trophic Levels")
  theGi <- toIGraph(EVList)

  theGiGain <- toIGraph(EVList, sign = 1)
  theGiLoss <- toIGraph(EVList, sign = -1)

  theLayout <- igraph::layout.circle(theGi)

  theSize <- match.arg(nodeSize, c("Abundance", "Size", "None"))
  if (theSize == "Abundance")
    theVs <- sqrt(igraph::vertex_attr(theGi)$N) * 10
  else if (theSize == "Size") {
    theVs <- igraph::vertex_attr(theGi)$M
    theVs <- sqrt(theVs / min(theVs)) * 10
  } else if (theSize == "None") {
    theVs <- 15
  }

  theColors <- ifelse(
    igraph::vertex_attr(theGi)$Type == "Basal", "skyblue", "red"
  )
  if ("Core" %in% names(igraph::vertex_attr(theGi))) {
    theShapes <- ifelse(igraph::vertex_attr(theGi)$Core,
                        0,
                        1)
  } else {
    theShapes <- 1 
    # Note Igraph uses "circle" then "rectangle",
    # but R and cheddar use "rectangle" then "circle", so we will use a !.
  }

  theBoth <- igraph::edge_attr(theGi)$effectNormalised
  theGain <- igraph::edge_attr(theGiGain)$effectNormalised
  theLoss <- igraph::edge_attr(theGiLoss)$effectNormalised

  theBoth[theBoth < threshold] <- 0
  theGain[theGain < threshold] <- 0
  theLoss[theLoss < threshold] <- 0

  # Inform the graphs of which edges are not needed.
  theGi <- igraph::delete_edges(theGi, which(theBoth == 0))
  theGiGain <- igraph::delete_edges(theGiGain, which(theGain == 0))
  theGiLoss <- igraph::delete_edges(theGiLoss, which(theLoss == 0))

  # Remove the same entries so that lengths match.
  theGain <- theGain[theGain > 0]
  theLoss <- theLoss[theLoss > 0]

  theGain <- theGain * edgeScale
  theLoss <- theLoss * edgeScale

  parold <- par(no.readonly = TRUE)
  par(mfrow = c(2, 2), # Two Rows, Two Columns
      mar = c(0, 1.5, 1, 0), # Margins, bottom, left, top, right
      oma = c(0.1, 0.1, 0.1, 0.1) # Outer margins.
  )

  cheddar::PlotWebByLevel(
    theGc,
    show.level.lines = TRUE,
    # Had been using LongWeighted, but that seems to give the upside down T.
    # Flow based seems to be more what we are expecting, given the usage of
    # thresholding and what that shows. The flows here are expected to be
    # flows of energy through the food web.
    level = cheddar::FlowBasedTrophicLevel(theGc, weight.by = "effectNormalised"),
      col = theColors,
      pch = theShapes
  )

  if (!reducedTrophic) {
    plot(
      theGi,
      layout = theLayout,
      vertex.size = theVs,
      edge.width = 1,
      edge.arrow.size = 0.3,
      edge.arrow.width = 1,
      vertex.color = theColors,
      vertex.shape = igraph::shapes()[as.numeric(!theShapes) + 1],
      edge.lty = 2,
      edge.color = "grey",
      edge.arrow.mode = ">",
      main = "Consumption"
    )
  } else {
    EVListRed <- EVList
    EVListRed$Edges <- EVListRed$Edges %>% dplyr::filter(
      effectNormalised >= threshold
    )
    theGc2 <- toCheddar(EVListRed, name = "Strongest Trophic Levels")
    cheddar::PlotWebByLevel(
      theGc2,
      show.level.lines = TRUE,
    level = cheddar::FlowBasedTrophicLevel(theGc2, weight.by = "effectNormalised"),
      col = theColors,
      pch = theShapes
    )
  }

  plot(
    theGiGain,
    layout = theLayout,
    vertex.size = theVs,
    edge.width = theGain,
    edge.arrow.size = 0.3,
    edge.arrow.width = 1,
    vertex.color = theColors,
      vertex.shape = igraph::shapes()[as.numeric(!theShapes) + 1],
    edge.lty = 2,
    edge.color = "blue",
    edge.arrow.mode = ">",
    main = "Consumer's Gains"
  )

  plot(
    theGiLoss,
    layout = theLayout,
    vertex.size = theVs,
    edge.width = theLoss,
    edge.arrow.size = 0.3,
    edge.arrow.width = 2,
    vertex.color = theColors,
      vertex.shape = igraph::shapes()[as.numeric(!theShapes) + 1],
    edge.lty = 3,
    edge.color = "darkred",
    edge.arrow.mode = "<",
    main = "Resource's Losses"
  )
  
  par(parold)
  
  EVList$Edges %>% dplyr::ungroup() %>% dplyr::filter(
    effectNormalised >= threshold
  ) %>% dplyr::select(
    -effectSign
  ) %>% dplyr::arrange(
    to, -effectNormalised
  )
}

Foodwebs, Overlapping

1

i <- 1
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

2

i <- 2
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

3

i <- 3
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

4

i <- 4
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

5

i <- 5
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

6

i <- 6
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

7

i <- 7
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

8

i <- 8
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

Foodwebs, Larger Food Preference

9

i <- 9
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

10

i <- 10
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

11

i <- 11
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

12

i <- 12
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

13

i <- 13
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

14

i <- 14
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

15

i <- 15
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

16

i <- 16
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

17

i <- 17
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

18

i <- 18
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp

19

i <- 19
toPostMortem(foodWebs[[i]], nodeSize = "None", threshold = "Adaptive") -> temp

temp